home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / personalpaint7.lha / PPaint / Rexx / Catalog.pprx < prev    next >
Encoding:
Text File  |  1997-04-19  |  22.3 KB  |  824 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1996, 1997 Cloanto Italia srl */
  2.  
  3. /* $VER: Catalog.pprx 1.2 */
  4.  
  5. /** ENG
  6.  This script creates reference catalogs ("thumbnails") for the images
  7.  contained in the specified directory.
  8.  
  9.  The first requester can be used to select the catalog background
  10.  (white, gray, or black), the number of thumbnail columns (i.e. images
  11.  per row) and the temporary file directory used by the script. It is also
  12.  possible to decide whether an optimized palette should be generated for
  13.  each catalog (based on thumbnail colors) or not (the palette of the
  14.  current environment is used). The "Test Mode" option quickly shows
  15.  a sample catalog preview based on the current settings.
  16.  
  17.  The catalog format is based on the current image format (width, height,
  18.  aspect ratio and number of colors). This also affects the number of
  19.  catalog files generated.
  20.  
  21.  If not in test mode, two file requesters follow: the first one can be used
  22.  to select the source directory, the second one to select the destination
  23.  directory (where the catalog files will be saved), the root of the file
  24.  name and the file format/options. If the base name contains one or more
  25.  consecutive "0" characters, they will be used and progressively replaced
  26.  to store the catalog number (e.g. "Cat_000.pic" becomes "Cat_001.pic",
  27.  "Cat_002.pic", etc.).
  28.  
  29.  If a catalog file (matching the specified base name) already exists in
  30.  the destination directory, a message asks for confirmation before deleting
  31.  the old files.
  32.  
  33.  Several program settings affect the quality of the catalog images
  34.  generated by this script. These settings are: Color Reduction, Dithering,
  35.  Color Average Resize. For best-quality results, the
  36.  Floyd-Steinberg/Best Quality dithering should be selected, the
  37.  Color Average Resize option should be activated and an appropriate image
  38.  format should be used (the higher the number of colors, the better):
  39.  this is likely to slow down the generation of the catalog, but greatly
  40.  enhances the quality of the thumbnail catalogs.
  41. */
  42.  
  43. /** DEU
  44.  Dieses Skript ermöglicht die Erstellung eines Bilderkatalogs mit
  45.  verkleinerten Abbildungen der in einem Verzeichnis enthaltenen
  46.  Grafiken (sog. "Thumbnails").
  47.  
  48.  Im ersten Dialogfenster lassen sich Elemente wie der Seitenhintergrund
  49.  (wahlweise Weiß, Grau oder Schwarz), Spaltenanzahl (d.h.
  50.  die Anzahl der Bilder pro Zeile) und das temporäre Dateiverzeichnis für
  51.  das Skript festlegen. Es besteht darüber hinaus auch die Möglichkeit,
  52.  für jeden Katalog eine (auf der Palette der Kleingrafiken
  53.  basierende) Palette generieren zu lassen. Wird dies nicht gewünscht,
  54.  verwendet das Skript die Palette der aktuellen Arbeitsumgebung.
  55.  Mit Hilfe der Option "Testmodus" läßt sich eine
  56.  Katalogvorschau auf der Grundlage der aktuellen Einstellungen anzeigen.
  57.  
  58.  Das Format des Bilderkatalogs basiert grundsätzlich auf dem aktuellen
  59.  Bildformat (Breite, Höhe, Seitenverhältnis und Anzahl der Farben).
  60.  Auch die Anzahl der erzeugten Katalogdateien wird dadurch beeinflußt.
  61.  
  62.  Wenn Sie sich nicht im Testmodus befinden, werden noch zwei weitere
  63.  Dateiauswahlfenster geöffnet: Das erste dient zur Auswahl des Quell-,
  64.  und das zweite entsprechend zur Festlegung des Zielverzeichnisses
  65.  (dort werden die Katalogdateien gespeichert) sowie des Dateinamenstamms
  66.  und einiger Optionen bezüglich des Dateiformats. Wenn der Stamm des
  67.  Dateinamens eine oder mehrere aufeinanderfolgende Nullen "0" enthält,
  68.  werden diese zur Speicherung der Katalognummer verwendet. Beispiel:
  69.  "Katze_000.pic" wird zu "Katze_001.pic", "Katze_002.pic", usw.
  70.  
  71.  Ist im Zielverzeichnis bereits eine Katalogdatei mit dem angegebenen
  72.  Namensstamm vorhanden, so erscheint vor dem Überschreiben der alten
  73.  Dateien zunächst eine Sicherheitsabfrage.
  74.  
  75.  Die Qualität der für den Bilderkatalog erzeugten Kleingrafiken läßt sich
  76.  durch die folgenden Programmeinstellungen beeinflussen:
  77.  Farbreduzierung, Fehlerverteilung, "Farben mit Größe ändern".
  78.  Um ein optimales Ergebnis zu erzielen, sollte wie folgt vorgegangen
  79.  werden: Schalten Sie als Ditheringverfahren "Floyd-Steinberg" ein,
  80.  aktivieren Sie die Option "Farben mit Größe ändern", und verwenden Sie
  81.  ein geeignetes Bildformat, wobei gilt: Je mehr Farben, desto besser.
  82.  Dies erfordert zwar u. U. einen größeren Zeitaufwand, liefert aber eine
  83.  erheblich verbesserte Qualität der im Bilderkatalog enthaltenen Grafiken.
  84. */
  85.  
  86. IF ARG(1, EXISTS) THEN
  87.     PARSE ARG PPPORT
  88. ELSE
  89.     PPPORT = 'PPAINT'
  90.  
  91. IF ~SHOW('P', PPPORT) THEN DO
  92.     IF EXISTS('PPaint:PPaint') THEN DO
  93.         ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
  94.         DO 30 WHILE ~SHOW('P',PPPORT)
  95.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  96.         END
  97.     END
  98.     ELSE DO
  99.         SAY "Personal Paint could not be loaded."
  100.         EXIT 10
  101.     END
  102. END
  103.  
  104. IF ~SHOW('P', PPPORT) THEN DO
  105.     SAY 'Personal Paint Rexx port could not be opened'
  106.     EXIT 10
  107. END
  108.  
  109. ADDRESS VALUE PPPORT
  110. OPTIONS RESULTS
  111. OPTIONS FAILAT 10000
  112.  
  113. Get 'LANG'
  114. IF RESULT = 1 THEN DO        /* Deutsch */
  115.     txt_test_tname    = 'Test.pic'
  116.     txt_title_set     = 'Katalogeinstellungen'
  117.     txt_title_font    = 'Font auswählen'
  118.     txt_title_src     = 'Quellverzeichnis auswählen'
  119.     txt_title_dst     = 'Format und Namensstamm auswählen'
  120.     txt_title_del     = 'Achtung'
  121.     txt_gad_bkg       = '_Hintergrund:'
  122.     txt_gad_bkg0      = 'Weiß'
  123.     txt_gad_bkg1      = 'Grau'
  124.     txt_gad_bkg2      = 'Schwarz'
  125.     txt_gad_colmn     = '_Spalten:'
  126.     txt_gad_recurse   = '_Unterverzeichnisse:'
  127.     txt_gad_workdir   = 'Ar_beitsverzeichnis:'
  128.     txt_gad_makeplt   = '_Palette erzeugen:'
  129.     txt_gad_test      = '_Test:'
  130.     txt_gad_yes       = '_Ja'
  131.     txt_gad_no        = '_Nein'
  132.     txt_msg_del0      = 'Sollen bestehende Alben'
  133.     txt_msg_del1      = 'gelöscht werden?'
  134.     txt_err_oldclient = 'Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich'
  135.     txt_err_resize    = 'Fehler bei Größenberechnung: '
  136.     txt_err_load      = 'Fehler beim Laden: '
  137.     txt_err_save      = 'Fehler beim Speichern: '
  138.     txt_err_creduc    = 'Fehler bei Farbreduzierung: '
  139.     txt_err_cremap    = 'Fehler bei Farbneuberechnung: '
  140. END
  141. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  142.     txt_test_tname    = 'Prova.pic'
  143.     txt_title_set     = 'Parametri catalogo'
  144.     txt_title_font    = 'Selezionare font'
  145.     txt_title_src     = 'Selezionare cassetto immagini'
  146.     txt_title_dst     = 'Selezionare nome e formato catalogo'
  147.     txt_title_del     = 'Attenzione'
  148.     txt_gad_bkg       = '_Sfondo:'
  149.     txt_gad_bkg0      = 'Bianco'
  150.     txt_gad_bkg1      = 'Grigio'
  151.     txt_gad_bkg2      = 'Nero'
  152.     txt_gad_colmn     = 'C_olonne:'
  153.     txt_gad_recurse   = "Tutti i _cassetti:"
  154.     txt_gad_workdir   = 'Cassetto di la_voro:'
  155.     txt_gad_makeplt   = 'Creare _tavolozza:'
  156.     txt_gad_test      = '_Prova:'
  157.     txt_gad_yes       = '_Sì'
  158.     txt_gad_no        = '_No'
  159.     txt_msg_del0      = 'I cataloghi esistenti'
  160.     txt_msg_del1      = 'devono essere cancellati?'
  161.     txt_err_oldclient = 'Questa procedura richiede_una versione più recente_di Personal Paint'
  162.     txt_err_resize    = 'Errore nel ridimensionamento: '
  163.     txt_err_load      = 'Errore nella lettura: '
  164.     txt_err_save      = 'Errore nella scrittura: '
  165.     txt_err_creduc    = 'Errore nella riduzione colori: '
  166.     txt_err_cremap    = 'Errore nell''adattamento colori: '
  167. END
  168. ELSE DO                /* English */
  169.     txt_test_tname    = 'Test.pic'
  170.     txt_title_set     = 'Catalog Settings'
  171.     txt_title_font    = 'Select Font'
  172.     txt_title_src     = 'Select Source Directory'
  173.     txt_title_dst     = 'Select Format and Root Name'
  174.     txt_title_del     = 'Attention'
  175.     txt_gad_bkg       = '_Background:'
  176.     txt_gad_bkg0      = 'White'
  177.     txt_gad_bkg1      = 'Gray'
  178.     txt_gad_bkg2      = 'Black'
  179.     txt_gad_colmn     = 'C_olumns:'
  180.     txt_gad_recurse   = '_Subdirectories:'
  181.     txt_gad_workdir   = '_Work Directory:'
  182.     txt_gad_makeplt   = '_Make Palette:'
  183.     txt_gad_test      = '_Test:'
  184.     txt_gad_yes       = '_Yes'
  185.     txt_gad_no        = '_No'
  186.     txt_msg_del0      = 'Should existing catalog files'
  187.     txt_msg_del1      = 'be deleted?'
  188.     txt_err_oldclient = 'This script requires a newer_version of Personal Paint'
  189.     txt_err_resize    = 'Error during resize: '
  190.     txt_err_load      = 'Error during load: '
  191.     txt_err_save      = 'Error during save: '
  192.     txt_err_creduc    = 'Color reduction error: '
  193.     txt_err_cremap    = 'Color remap error: '
  194. END
  195.  
  196. Version 'REXX'
  197. IF RESULT < 7 THEN DO
  198.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  199.     EXIT 10
  200. END
  201.  
  202. srcdir      = LoadSet('SourceDir',  'PPaint:Pictures', 0)
  203. dstdir      = LoadSet('DestDir',    'PPaint:Pictures', 0)
  204. dstfile     = LoadSet('DestFile',   '000_Catalog.pic', 0)
  205. dstformat   = LoadSet('DestFormat', '', 0)
  206. fontpath    = LoadSet('FontPath',   'FONTS:', 0)
  207. fontname    = LoadSet('FontName',   'CGTriumvirate', 0)
  208. fontsize    = LoadSet('FontSize',    12, 0)
  209. fontstyle   = LoadSet('FontStyle',   's', 0)
  210. backgr      = LoadSet('Background',  0)
  211. columns     = LoadSet('Columns',     5)
  212. makepalette = LoadSet('MakePalette', 1)
  213. recurse     = LoadSet('Recurse',     0)
  214. tempdir     = LoadSet('TempDir',     'T:')
  215. test        = LoadSet('Test',        0)
  216.  
  217. max_tempdir_size = 80
  218.  
  219. FreeEnvironment 'QUERY'
  220. IF RC ~= 0 THEN
  221.     EXIT RC
  222. FreeBrush
  223. IF RC ~= 0 THEN
  224.     EXIT RC
  225.  
  226. Request '"'txt_title_set'" ' ||,
  227.             '"CYCLE = ""'txt_gad_bkg'"", 3, 'backgr', ""'txt_gad_bkg0'"", ""'txt_gad_bkg1'"", ""'txt_gad_bkg2'"" ' ||,
  228.             ' INTSTR = ""'txt_gad_colmn'"", 1, 32767, 'columns' ' ||,
  229.             ' STRING = ""'txt_gad_workdir'"", 'max_tempdir_size', ""'tempdir'"" ' ||,
  230.             ' CHECK = ""'txt_gad_makeplt'"", 'makepalette' ' ||,
  231.             ' CHECK = ""'txt_gad_recurse'"", 'recurse' ' ||,
  232.             ' CHECK = ""'txt_gad_test'"", 'test' "'
  233. IF RC ~= 0 THEN
  234.     EXIT RC
  235. backgr  = RESULT.1
  236. columns = RESULT.2
  237. tempdir = RESULT.3
  238. makepalette = RESULT.4
  239. recurse = RESULT.5
  240. test    = RESULT.6
  241.  
  242. delete_old = 0
  243.  
  244. RequestFont '"'txt_title_font'" PATH "'fontpath'" NAME "'fontname'" SIZE "'fontsize'" STYLE "'fontstyle'"'
  245. IF RC ~= 0 THEN
  246.     EXIT RC
  247. PARSE VALUE RESULT WITH '"' fontpath '" "' fontname '"' fontsize fontstyle
  248.  
  249. IF ~test THEN DO
  250.     RequestPath '"'txt_title_src'" PATH "'srcdir'"'
  251.     IF RC ~= 0 THEN
  252.         EXIT RC
  253.     PARSE VALUE RESULT WITH '"' srcdir '"'
  254.  
  255.     RequestFile 'TITLE "'txt_title_dst'" PATH "'dstdir'" FILE "'dstfile'" SAVEMODE LISTFORMATS FORCE' dstformat
  256.     IF RC ~= 0 THEN
  257.         EXIT RC
  258.     PARSE VALUE RESULT WITH '"' dstdfile '"' dstformat
  259.     ppos = MAX(LASTPOS(':', dstdfile), LASTPOS('/', dstdfile)) + 1
  260.     dstdir = LEFT(dstdfile, ppos-1)
  261.     dstfile = SUBSTR(dstdfile, ppos)
  262.  
  263.     IF RIGHT(dstdir, 1) = '/' THEN
  264.         dst = LEFT(dstdfile, ppos-2)
  265.     ELSE
  266.         dst = dstdir
  267.     same_srcdst = (dst == srcdir)
  268.  
  269.     tmpfname = 'T:pprx_cat.'PRAGMA('ID')
  270.     destpattern = CatalogFName(dstfile, 0, 1)
  271.  
  272.     LockGUI
  273.     IF recurse & same_srcdst THEN
  274.         ADDRESS COMMAND 'List >'tmpfname' "'srcdir'" NOHEAD PAT="'destpattern'" LFORMAT="%s%s" FILES ALL'
  275.     ELSE
  276.         ADDRESS COMMAND 'List >'tmpfname' "'dstdir'" NOHEAD PAT="'destpattern'" LFORMAT="%s%s" FILES'
  277.     UnlockGUI
  278.  
  279.     oldfiles = 0
  280.     IF OPEN('listfile', tmpfname, 'R') THEN DO
  281.         IF LENGTH(READLN('listfile')) > 0 THEN
  282.             oldfiles = 1
  283.         CALL CLOSE('listfile')
  284.     END
  285.     ADDRESS COMMAND 'Delete >NIL: 'tmpfname
  286.     IF oldfiles THEN DO
  287.         Request '"'txt_title_del'" ' ||,
  288.                     '"TEXT = ""'txt_msg_del0'"" ' ||,
  289.                     ' TEXT = ""'txt_msg_del1'"" ' ||,
  290.                     ' ACTION = ""'txt_gad_yes'"" ACTION = ""'txt_gad_no'"" ACTION = CANCEL"'
  291.         IF RC ~= 0 THEN
  292.             EXIT RC
  293.         IF RESULT = 1 THEN
  294.             delete_old = 1
  295.     END
  296. END
  297.  
  298.  
  299.  
  300. LockGUI
  301.  
  302. CALL SaveSet('SourceDir',   srcdir)
  303. CALL SaveSet('DestDir',     dstdir)
  304. CALL SaveSet('DestFile',    dstfile)
  305. CALL SaveSet('DestFormat',  dstformat)
  306. CALL SaveSet('FontPath',    fontpath)
  307. CALL SaveSet('FontName',    fontname)
  308. CALL SaveSet('FontSize',    fontsize)
  309. CALL SaveSet('FontStyle',   fontstyle)
  310. CALL SaveSet('Background',  backgr)
  311. CALL SaveSet('Columns',     columns)
  312. CALL SaveSet('MakePalette', makepalette)
  313. CALL SaveSet('Recurse',     recurse)
  314. CALL SaveSet('TempDir',     tempdir)
  315. CALL SaveSet('Test',        test)
  316.  
  317.  
  318.  
  319. Get 'COLORS'
  320. cnum = RESULT
  321. Get 'IMAGEW'
  322. imgwidth = RESULT
  323. Get 'IMAGEH'
  324. imgheight = RESULT
  325. GetImageAttributes 'DPIX'
  326. hdpi = RESULT
  327. GetImageAttributes 'DPIY'
  328. imgratio = hdpi / RESULT
  329. Get 'CAVRESIZE'
  330. cavrg = RESULT
  331.  
  332. hgap  = TRUNC((imgwidth / columns) / 6)
  333. tilew = TRUNC((imgwidth - (hgap * (columns + 1))) / columns)
  334. hgap  = TRUNC((imgwidth - (tilew * columns)) / (columns + 1))
  335. vgap  = hgap % imgratio
  336. tileh = tilew % imgratio
  337. txgap = vgap % 10
  338.  
  339. htgap = imgwidth % 100
  340. thmbw = tilew - (htgap * 2)
  341. vtgap = htgap % imgratio
  342. thmbh = tileh - (vtgap * 2)
  343.  
  344. CALL FindPens
  345.  
  346. GetArea
  347. areasets = RESULT
  348. SetArea 'FILLSOLID'
  349. tmpfname = ''
  350. tmpdname = ''
  351.  
  352. Get 'GCLIP'
  353. saveclip = RESULT
  354. Set '"GCLIP=0"'
  355.  
  356. SIGNAL ON Break_C
  357.  
  358. IF test THEN DO
  359.     CALL InitPage
  360.     brushw = thmbw
  361.     brushh = (thmbh % 3) * 2
  362.     brushname = txt_test_tname
  363.     DO UNTIL AddTile(0)
  364.     END
  365.     CALL Break_C
  366.     EXIT 0
  367. END
  368.  
  369. dir_trail = RIGHT(tempdir, 1)
  370. IF dir_trail ~= ':' & dir_trail ~= '/' THEN
  371.     tempdir = tempdir || '/'
  372. tempdir = tempdir || PRAGMA('ID')
  373. ADDRESS COMMAND 'MakeDir >NIL: "'tempdir'"'
  374. IF RC ~= 0 THEN
  375.     EXIT RC
  376. tempdir = tempdir || '/'
  377.  
  378. tmpdname = 'T:pprx_dcat.'PRAGMA('ID')
  379. tmpfname = 'T:pprx_cat.'PRAGMA('ID')
  380. tmpfname2 = tmpfname || '.2'
  381.  
  382. IF OPEN('listfile', tmpdname, 'W') THEN DO
  383.     CALL WRITELN('listfile', srcdir)
  384.     CALL CLOSE('listfile')
  385. END
  386. IF recurse THEN
  387.     ADDRESS COMMAND 'List >>'tmpdname' "'srcdir'" NOHEAD LFORMAT="%s%s" DIRS ALL'
  388.  
  389. IF OPEN('dirlistfile', tmpdname, 'R') THEN DO
  390.     cancelled = 0
  391.     catnum = 1
  392.     DO FOREVER
  393.         srcdir = READLN('dirlistfile')
  394.         IF EOF('dirlistfile') THEN
  395.             LEAVE
  396.  
  397.         IF recurse & same_srcdst THEN DO
  398.             dstdir = srcdir
  399.             dir_trail = RIGHT(dstdir, 1)
  400.             IF dir_trail ~= ':' & dir_trail ~= '/' THEN
  401.                 dstdir = dstdir || '/'
  402.         END
  403.  
  404.         IF delete_old THEN DO
  405.             dir_trail = RIGHT(dstdir, 1)
  406.             IF dir_trail ~= ':' & dir_trail ~= '/' THEN
  407.                 deldir = dstdir || '/'
  408.             ELSE
  409.                 deldir = dstdir
  410.             ADDRESS COMMAND 'Delete >NIL: "'deldir || destpattern'"'
  411.             ADDRESS COMMAND 'Delete >NIL: "'deldir || destpattern'.info"'
  412.         END
  413.  
  414.         ADDRESS COMMAND 'List >'tmpfname' "'srcdir'" NOHEAD PAT=~(#?.info) LFORMAT="%s%s" FILES'
  415.         IF RC = 0 THEN DO
  416.             ADDRESS COMMAND 'Sort 'tmpfname tmpfname'.s'
  417.             IF RC = 0 THEN DO
  418.                 ADDRESS COMMAND 'Delete >NIL: 'tmpfname
  419.                 tmpfname = tmpfname'.s'
  420.             END
  421.         END
  422.  
  423.         IF OPEN('listfile', tmpfname, 'R') THEN DO
  424.             errmess = ''
  425.             done = 0
  426.             IF (~recurse) | same_srcdst THEN
  427.                 catnum = 1
  428.  
  429.             DO UNTIL done
  430.                 CALL InitPage
  431.                 thmbcolors = ''
  432.                 gottn = 0
  433.                 DO FOREVER
  434.                     fname = READLN('listfile')
  435.                     IF EOF('listfile') THEN DO
  436.                         done = 1
  437.                         LEAVE
  438.                     END
  439.                     LoadBrush '"'fname'" QUIET FORCE NOPROGRESS'
  440.                     IF RC = 0 THEN DO
  441.                         GetBrushAttributes 'WIDTH'
  442.                         bw = RESULT
  443.                         GetBrushAttributes 'HEIGHT'
  444.                         bh = RESULT
  445.                         GetBrushAttributes 'DPIX'
  446.                         bhdpi = RESULT
  447.                         GetBrushAttributes 'DPIY'
  448.                         bvdpi = RESULT
  449.                         bratio = bhdpi / bvdpi
  450.  
  451.                         brushw = thmbw;
  452.                         brushh = TRUNC(((brushw / (bw / bh)) * bratio) / imgratio)
  453.                         IF brushh > thmbh THEN DO
  454.                             brushh = thmbh;
  455.                             brushw = TRUNC(((brushh / (bh / bw)) / bratio) * imgratio)
  456.                         END
  457.  
  458.                         IF cavrg = 0 THEN
  459.                             SetBrushAttributes 'WIDTH 'brushw' HEIGHT 'brushh' NOPROGRESS'
  460.                         ELSE
  461.                             SetBrushAttributes 'WIDTH 'brushw' HEIGHT 'brushh' COLORS 256 EXTENDPALETTE NOPROGRESS'
  462.                         IF RC = 0 THEN DO
  463.                             IF makepalette THEN DO
  464.                                 BrushColorStatistics 'COLORS COMPACT NOPROGRESS'
  465.                                 IF RC = 0 THEN DO
  466.                                     thcolors = RESULT
  467.                                     IF (LENGTH(thmbcolors) + LENGTH(thcolors)) < 65535 THEN
  468.                                         thmbcolors = thmbcolors thcolors
  469.                                 END
  470.                             END
  471.                             ppos = MAX(LASTPOS(':', fname), LASTPOS('/', fname)) + 1
  472.                             brushname = SUBSTR(fname, ppos)
  473.  
  474.                             SaveBrush '"'tempdir || brushname'" QUIET FORCE NOPROGRESS'
  475.                             IF RC = 0 THEN DO
  476.                                 gottn = 1
  477.                                 IF AddTile(0) THEN
  478.                                     LEAVE
  479.                             END
  480.                             ELSE DO
  481.                                 done = 1
  482.                                 errmess = txt_err_resize || RC
  483.                                 LEAVE
  484.                             END
  485.                         END
  486.                     END
  487.                     ELSE DO
  488.                         IF RC ~= 38 THEN DO    /* unrecognized format? */
  489.                             done = 1
  490.                             errmess = txt_err_load || RC
  491.                             LEAVE
  492.                         END
  493.                     END
  494.                 END
  495.  
  496.                 IF errmess ~= '' | gottn = 0 THEN
  497.                     LEAVE
  498.  
  499.                 IF makepalette THEN DO
  500.                     ReduceColors cnum '"'thmbcolors'"'
  501.                     IF RC ~= 0 THEN DO
  502.                         done = 1
  503.                         IF RC = 5 THEN
  504.                             cancelled = 1
  505.                         ELSE
  506.                             errmess = txt_err_creduc || RC
  507.                         LEAVE
  508.                     END
  509.                 END
  510.                 ELSE RC = 0
  511.  
  512.                 IF RC = 0 THEN DO
  513.                     IF makepalette THEN DO
  514.                         SetColors 'COLORS "'RESULT'"'
  515.                         CALL FindPens
  516.                     END
  517.  
  518.                     tmpfname2 = tmpfname || '.2'
  519.                     ADDRESS COMMAND 'List >'tmpfname2' "'tempdir'" NOHEAD PAT=~(#?.info) LFORMAT="%s%s" FILES'
  520.                     IF RC = 0 THEN DO
  521.                         ADDRESS COMMAND 'Sort 'tmpfname2 tmpfname2'.s'
  522.                         IF RC = 0 THEN DO
  523.                             ADDRESS COMMAND 'Delete >NIL: 'tmpfname2
  524.                             tmpfname2 = tmpfname2'.s'
  525.                         END
  526.                     END
  527.                     IF OPEN('listfile2', tmpfname2, 'R') THEN DO
  528.                         CALL InitPage
  529.  
  530.                         DO FOREVER
  531.                             fname = READLN('listfile2')
  532.                             IF EOF('listfile2') THEN
  533.                                 LEAVE
  534.                             LoadBrush '"'fname'" QUIET FORCE NOPROGRESS'
  535.                             IF RC = 0 THEN DO
  536.                                 GetBrushAttributes 'WIDTH'
  537.                                 brushw = RESULT
  538.                                 GetBrushAttributes 'HEIGHT'
  539.                                 brushh = RESULT
  540.  
  541.                                 RemapBrush 'NOPROGRESS'
  542.                                 IF RC = 0 THEN DO
  543.                                     ppos = MAX(LASTPOS(':', fname), LASTPOS('/', fname)) + 1
  544.                                     brushname = SUBSTR(fname, ppos)
  545.                                     IF AddTile(1) THEN
  546.                                         LEAVE
  547.                                 END
  548.                                 ELSE DO
  549.                                     done = 1
  550.                                     errmess = txt_err_cremap || RC
  551.                                     LEAVE
  552.                                 END
  553.                             END
  554.                             ELSE DO
  555.                                 done = 1
  556.                                 errmess = txt_err_load || RC
  557.                                 LEAVE
  558.                             END
  559.                         END
  560.                         CALL CLOSE('listfile2')
  561.  
  562.                         SaveImage '"'dstdir || CatalogFName(dstfile, catnum)'" FORCE QUIET' dstformat
  563.                         IF RC ~= 0 THEN DO
  564.                             done = 1
  565.                             IF RC = 5 THEN
  566.                                 cancelled = 1
  567.                             ELSE
  568.                                 errmess = txt_err_save || RC
  569.                         END
  570.                         catnum = catnum + 1
  571.                     END
  572.                     ADDRESS COMMAND 'Delete >NIL: 'tmpfname2
  573.                 END
  574.                 ADDRESS COMMAND 'Delete >NIL: "'tempdir'#?" QUIET'
  575.             END
  576.             CALL CLOSE('listfile')
  577.         END
  578.         IF errmess ~= '' THEN DO
  579.             RequestNotify 'PROMPT "'errmess'"'
  580.             LEAVE
  581.         END
  582.         IF cancelled THEN
  583.             LEAVE
  584.     END
  585.     CALL CLOSE('dirlistfile')
  586. END
  587.  
  588. CALL Break_C
  589.  
  590. EXIT 0
  591.  
  592.  
  593.  
  594.  
  595. InitPage:
  596.  
  597.     SetPen 'BACKGROUND 'colbackg
  598.     ClearImage
  599.  
  600.     clmn = 1
  601.     ypos = vgap
  602.     xpos = hgap
  603.  
  604.     RETURN
  605.  
  606.  
  607.  
  608.  
  609. FindPens:
  610.  
  611.     penpass = 0
  612.  
  613.     DO FOREVER
  614.         IF backgr = 0 THEN
  615.             FindColor '"255 255 255"'
  616.         ELSE IF backgr = 1 THEN
  617.             FindColor '"213 213 213"'
  618.         ELSE
  619.             FindColor '"0 0 0"'
  620.         colbackg = RESULT
  621.  
  622.         IF penpass = 0 THEN
  623.             FindColor '"213 213 213"'
  624.         ELSE
  625.             FindColor '"213 213 213" EXCLUDE "'colbackg'"'
  626.         coltile = RESULT
  627.  
  628.         IF backgr = 2 THEN
  629.             FindColor '"255 255 255"'
  630.         ELSE
  631.             FindColor '"0 0 0"'
  632.         coltext = RESULT
  633.  
  634.         FindColor '"0 0 0"'
  635.         colblack = RESULT
  636.         FindColor '"68 68 68"'
  637.         coldark1 = RESULT
  638.         FindColor '"140 140 140"'
  639.         coldark2 = RESULT
  640.         FindColor '"255 255 255"'
  641.         collight1 = colbackg
  642.         FindColor '"240 240 240"'
  643.         collight2 = RESULT
  644.  
  645.         penpass = penpass + 1
  646.         IF penpass > 1 THEN
  647.             LEAVE
  648.         IF collight1 ~= coltile & coldark1 ~= coltile THEN
  649.             LEAVE
  650.     END
  651.  
  652.     RETURN
  653.  
  654.  
  655.  
  656.  
  657. CatalogFName:
  658.     basefname = ARG(1)
  659.     catlgnum  = ARG(2)
  660.     IF ARG() > 2 THEN
  661.         pattern_fname = ARG(3)
  662.     ELSE
  663.         pattern_fname = 0
  664.  
  665.     npos1 = INDEX(basefname, '0')
  666.     IF npos1 = 0 THEN
  667.         RETURN basefname
  668.  
  669.     ndigits = 1
  670.     bfnlen = LENGTH(basefname)
  671.     DO npos = npos1 + 1 TO bfnlen
  672.         IF SUBSTR(basefname, npos, 1) = '0' THEN
  673.             ndigits = ndigits + 1
  674.         ELSE
  675.             LEAVE
  676.     END
  677.     IF pattern_fname THEN
  678.         catgfname = LEFT(basefname, npos1 - 1) || '#?' || SUBSTR(basefname, npos)
  679.     ELSE
  680.         catgfname = LEFT(basefname, npos1 - 1) || RIGHT(catlgnum, ndigits, "0") || SUBSTR(basefname, npos)
  681.  
  682.     RETURN catgfname
  683.  
  684.  
  685.  
  686. AddTile:
  687.     with_brush = ARG(1)
  688.  
  689.     SetPen 'FOREGROUND 'coltile
  690.     DrawRectangle xpos ypos xpos+tilew-1 ypos+tileh-1 'FILL'
  691.  
  692.     xp0 = xpos + htgap + ((thmbw - brushw) % 2)
  693.     yp0 = ypos + vtgap + ((thmbh - brushh) % 2)
  694.  
  695.     IF collight1 ~= coltile & coldark1 ~= coltile THEN DO
  696.         xp1 = xp0 + brushw - 1
  697.         yp1 = yp0 + brushh - 1
  698.         xps1 = xpos + tilew - 1
  699.         yps1 = ypos + tileh - 1
  700.  
  701.         SetPen 'FOREGROUND 'collight1
  702.         DrawRectangle xp0    yp1+1  xp1+1   yp1+1 'FILL'
  703.         DrawRectangle xp1+1  yp1+1  xp1+1   yp0-1 'FILL'
  704.         DrawRectangle xpos    yps1  xpos    ypos  'FILL'
  705.         DrawRectangle xpos    ypos  xps1-1  ypos  'FILL'
  706.         SetPen 'FOREGROUND 'coldark1
  707.         DrawRectangle xp0-1  yp1+1  xp0-1   yp0-1 'FILL'
  708.         DrawRectangle xp0-1  yp0-1  xp1     yp0-1 'FILL'
  709.         DrawRectangle xpos+1  yps1  xps1    yps1  'FILL'
  710.         DrawRectangle xps1    yps1  xps1    ypos  'FILL'
  711.  
  712.         IF collight1 ~= collight2 & coldark1 ~= coldark2 THEN DO
  713.             SetPen 'FOREGROUND 'collight2
  714.             DrawRectangle xp0-1    yp1+2  xp1+2   yp1+2  'FILL'
  715.             DrawRectangle xp1+2    yp1+2  xp1+2   yp0-2  'FILL'
  716.             DrawRectangle xpos+1  yps1-1  xpos+1  ypos+1 'FILL'
  717.             DrawRectangle xpos+1  ypos+1  xps1-2  ypos+1 'FILL'
  718.             SetPen 'FOREGROUND 'coldark2
  719.             DrawRectangle xp0-2    yp1+2  xp0-2   yp0-2  'FILL'
  720.             DrawRectangle xp0-2    yp0-2  xp1+1   yp0-2  'FILL'
  721.             DrawRectangle xpos+2  yps1-1  xps1-1  yps1-1 'FILL'
  722.             DrawRectangle xps1-1  yps1-1  xps1-1  ypos+1 'FILL'
  723.         END
  724.     END
  725.  
  726.     IF with_brush THEN DO
  727.         SetPaintMode 'REPLACE'
  728.         SetBrushHandle 'UPPERLEFT'
  729.         PutBrush xp0 yp0
  730.     END
  731.     ELSE DO
  732.         SetPen 'FOREGROUND 'colblack
  733.         DrawRectangle xp0 yp0 xp0+brushw-1 yp0+brushh-1 'FILL'
  734.     END
  735.  
  736.     textyp = ypos + tileh + txgap
  737.     textx0 = xpos - hgap
  738.     textx1 = xpos + tilew + hgap - 1
  739.     SetPen 'FOREGROUND 'coltext
  740.     VectorText 'TEXT "'brushname'" FONTPATH "'fontpath'" FONTNAME "'fontname'" X0 'textx0' Y0 'textyp' X1 'textx1' Y1' (textyp + fontsize - 1) 'CENTER ANTIALIAS 2 KEEPRATIO KEEPBASELINE'
  741.     IF RC ~= 0 THEN
  742.         Text 'TEXT "'brushname'" FONTPATH "'fontpath'" FONTNAME "'fontname'" FONTSIZE 'fontsize' FONTSTYLE "'fontstyle'" X' (xpos + (tilew % 2)) ' Y 'textyp' CENTER'
  743.  
  744.     last_one = 0
  745.     xpos = xpos + tilew + hgap
  746.     clmn = clmn + 1
  747.     IF clmn > columns THEN DO
  748.         clmn = 1
  749.         xpos = hgap
  750.         totvgap = tileh + txgap + fontsize + (vgap % 3)
  751.         ypos = ypos + totvgap
  752.         IF (ypos + totvgap) > imgheight THEN
  753.             last_one = 1
  754.     END
  755.  
  756.     RETURN last_one
  757.  
  758.  
  759.  
  760.  
  761. SaveSet:
  762.     sname = ARG(1)
  763.     val = ARG(2)
  764.  
  765.     IF OPEN('settingfile', 'ENV:PP_Catal_'sname, 'W') THEN DO
  766.         CALL WRITECH('settingfile', val)
  767.         CALL CLOSE('settingfile')
  768.     END
  769.  
  770.     RETURN
  771.  
  772.  
  773.  
  774.  
  775. LoadSet:
  776.     sname = ARG(1)
  777.     def_val = ARG(2)
  778.     IF ARG() > 2 THEN
  779.         request_quote = ARG(3)
  780.     ELSE
  781.         request_quote = 1
  782.  
  783.     val = def_val
  784.     set_fname = 'ENV:PP_Catal_'sname
  785.  
  786.     IF OPEN('settingfile', set_fname, 'R') THEN DO
  787.         val = READCH('settingfile', 65535)
  788.         CALL CLOSE('settingfile')
  789.     END
  790.  
  791.     IF request_quote THEN DO
  792.         /* encode quotes for the Request command ('"' -> '\""') */
  793.         qpos_start = 1
  794.         DO FOREVER
  795.             qpos = INDEX(val, '"', qpos_start)
  796.             IF qpos = 0 THEN BREAK
  797.             val = INSERT('\"', val, qpos-1)
  798.             qpos_start = qpos + 3
  799.         END
  800.     END
  801.  
  802.     RETURN val
  803.  
  804.  
  805.  
  806.  
  807.  
  808. Break_C:
  809.  
  810.     IF tmpfname ~= '' THEN DO
  811.         ADDRESS COMMAND 'Delete >NIL: "'tempdir'" ALL QUIET'
  812.         ADDRESS COMMAND 'Delete >NIL: 'tmpfname tmpfname2
  813.     END
  814.     IF tmpdname ~= '' THEN
  815.         ADDRESS COMMAND 'Delete >NIL: 'tmpdname
  816.  
  817.     FreeBrush 'FORCE'
  818.     SelectSquareBrush 1
  819.     SetArea areasets
  820.     Set '"GCLIP='saveclip'"'
  821.     UnlockGUI
  822.  
  823.     RETURN 1
  824.